home *** CD-ROM | disk | FTP | other *** search
/ Delphi Developer's Kit 1996 / Delphi Developer's Kit 1996.iso / power / dbmemox / dbmemox.pas < prev    next >
Pascal/Delphi Source File  |  1995-12-22  |  8KB  |  322 lines
  1. {$D- $L-  $Y-}
  2.  
  3. {$IFDEF NEVER}
  4.  
  5. TDBMemoXpld:
  6.  
  7. The TDBMemoXpld Control inherits most of its functionality
  8. from the TDBMemo Control, except that, when it does not have
  9. focus, it takes up minimal real estate and it 'explodes' when
  10. it receives focus.  Browse the properties and it should become
  11. clear how to use this control.
  12.  
  13. In the compressed state, it will display as much text as
  14. possible on one line followed by '...'.
  15.  
  16. If the control is parented by a TPanel (or descendant), the
  17. expanded version will explode beyond the boundaries of the TPanel.
  18.  
  19. As a default, this control will install on the samples page.  If
  20. you want it somewhere else create an ini file named dbmemox.ini.
  21. Include the following:
  22.  
  23.    [Install]
  24.    Page=pagename
  25.  
  26. Or, you can change the source (not recommended).
  27.  
  28. To install: copy dbmemox.dcr and dbmemox.dcu to a directory
  29.             in your install components search path.
  30.  
  31.             add dbmemox to your component list, and rebuild.
  32.  
  33.  
  34.  
  35. Version: 0.99
  36.  
  37. Date: 6/5/95
  38.  
  39. Author: Wm. Rubenstein, 76675,2251 (Compuserve)
  40.  
  41. Disclaimer:  All the usual about liability.
  42.              All the usual about who owns this code.
  43.              This is freeware.
  44.  
  45.  
  46. ################################################################
  47.  
  48. {$ENDIF}
  49.  
  50. unit Dbmemox;
  51.  
  52. interface
  53. uses
  54.   SysUtils, WinTypes, WinProcs, Classes, Graphics, Controls,
  55.   StdCtrls, DBCtrls, ExtCtrls, IniFiles;
  56.  
  57. type
  58.   TDBMemoXpld = class(TDBMemo)
  59.   private
  60.     { Private declarations }
  61.     FCanvas: TControlCanvas;  {used to measure text}
  62.     FExploded: Boolean;
  63.     FWidthExpld: Integer;
  64.     FHeightExpld: Integer;
  65.     FWidth: integer;
  66.     FHeight: integer;
  67.     FEdit: TEdit; {this is a second control--used to display
  68.                   the compressed version of the data}
  69.     FOnExit: TNotifyEvent;
  70.     procedure SetExploded(Value: boolean);
  71.     procedure SetWidthExpld(Value: integer);
  72.     procedure SetHeightExpld(Value: integer);
  73.     procedure CreateEdit;
  74.     procedure FEditMouseDown(Sender: TObject; Button: TMouseButton;
  75.                 Shift: TShiftState; X, Y: Integer);
  76.     procedure FEditOnEnter(Sender: TObject);
  77.     procedure MemoOnExit(Sender: TObject);
  78.   protected
  79.     { Protected declarations }
  80.     procedure change; override;
  81.     procedure loaded; override;
  82.  
  83.   public
  84.     { Public declarations }
  85.     constructor Create(AOwner: TComponent); override;
  86.     destructor Destroy; override;
  87.     property Exploded: Boolean read FExploded write SetExploded;
  88.  
  89.   published
  90.     { Published declarations }
  91.     property WidthExpld: Integer read FWidthExpld
  92.                          write SetWidthExpld;
  93.     property HeightExpld: Integer read FHeightExpld
  94.                           write SetHeightExpld;
  95. end;
  96.  
  97. procedure Register;
  98.  
  99. implementation
  100.  
  101. constructor TDBMemoXpld.Create(AOwner: TComponent);
  102. begin
  103.    inherited Create(AOwner);
  104.    FCanvas := TControlCanvas.Create;
  105.    FCanvas.Control := Self;
  106.    FExploded := false;
  107.    Height := 25;
  108.    Width := 90;
  109.    FheightExpld := 185;
  110.    FWidthExpld := 90;
  111.    WordWrap := true;
  112. end;
  113.  
  114. destructor TDBMemoXpld.Destroy;
  115. begin
  116.    FCanvas.Free;
  117.    inherited Destroy;
  118. end;
  119.  
  120. procedure TDBMemoXpld.Loaded;
  121. begin
  122.    inherited loaded;
  123.    FWidth := Width;
  124.    FHeight := Height;
  125. end;
  126.  
  127. procedure TDBMemoXpld.SetExploded(Value: boolean);
  128. begin;
  129.    if FExploded <> Value then
  130.    begin
  131.       FExploded := Value;
  132.       Change;
  133.    end;
  134. end;
  135.  
  136. procedure TDBMemoXpld.SetWidthExpld(Value: integer);
  137. begin
  138.    FWidthExpld := Value;
  139. end;
  140.  
  141. procedure TDBMemoXpld.SetHeightExpld(Value: integer);
  142. begin
  143.    FHeightExpld := Value;
  144. end;
  145.  
  146. procedure TDBMemoXpld.Change;
  147. var
  148.    s: string;
  149.    DC: HDC;
  150.    WindowHandle: THandle;
  151.    Width, AvailWidth, i: integer;
  152.    ellipse: string;
  153. begin
  154.    if (csDesigning in ComponentState) or
  155.       (csLoading in ComponentState) then
  156.       exit;
  157.  
  158.    if FEdit = nil then CreateEdit;
  159.  
  160.    if FExploded then
  161.    begin
  162.       FEdit.Hide;
  163.       BringToFront;
  164.       Show;
  165.       inherited Change;
  166.       exit;
  167.    end;
  168.    {compressed so get some text.}
  169.    try
  170.       Hide;
  171.       FEdit.Show;
  172.       ellipse := '...';
  173.       AvailWidth := FEdit.clientWidth - 5;
  174.       WindowHandle := FEdit.Handle;
  175.       DC := GetDC(WindowHandle);
  176.       FCanvas.Handle := DC;
  177.       FCanvas.Font := Font;
  178.  
  179.       i := 0;
  180.       s := '';
  181.       {Accumulate enought lines to fill the
  182.       control, if possible}
  183.       while i < Lines.Count do
  184.       begin
  185.          s := s + Lines.Strings[i];
  186.          if FCanvas.TextWidth(s) >= AvailWidth then
  187.             break;
  188.          INC(i);
  189.       end;
  190.  
  191.       if i >= Lines.Count then
  192.          ellipse := ''; {We have it all}
  193.       i := length(s);
  194.       while true do
  195.       begin
  196.          {Backscan for non-space char}
  197.          while (i > 0) and (s[i] = ' ') do
  198.             DEC(i);
  199.          s[0] := Char(i);
  200.          if FCanvas.TextWidth(s + ellipse) < AvailWidth then
  201.             break; {What we have will fit}
  202.          {It won't fit, so backscan for space
  203.          and go again}
  204.          while (i > 0) and (s[i] <> ' ') do
  205.             DEC(i);
  206.          s[0] := Char(i);
  207.          ellipse := '...';
  208.       end;
  209.       s := s + ellipse + char(0);
  210.       SetWindowText(FEdit.Handle, Addr(s[1]));
  211.       inherited Change;
  212.    finally
  213.       ReleaseDC(WindowHandle, DC);
  214.       FCanvas.Handle := 0;
  215.    end;
  216. end;
  217.  
  218. procedure TDBMemoXpld.FEditMouseDown(Sender: TObject; Button: TMouseButton;
  219.   Shift: TShiftState; X, Y: Integer);
  220. begin
  221.    if Button = mbLeft then
  222.       Exploded := true;
  223.    {Execute mousedown for the real control}
  224.    MouseDown(Button, Shift, X, Y);
  225. end;
  226.  
  227. procedure TDBMemoXpld.FEditOnEnter(Sender: TObject);
  228. begin
  229.    Exploded := true;
  230.    SetFocus; {to the real control}
  231. end;
  232.  
  233. procedure TDBMemoXpld.MemoOnExit(Sender: TObject);
  234. begin;
  235.    Exploded := False;
  236.    if Assigned(FOnExit) then
  237.       FOnExit(Sender);
  238. end;
  239.  
  240. procedure TDBMemoXpld.CreateEdit;
  241. {Create the new compressed control}
  242. var
  243.    T: TComponent;
  244.    P: TLabel;
  245.    i: integer;
  246. begin
  247.    if Parent is TPanel then
  248.    begin
  249.       FEdit := TEdit.Create(Parent.Parent);
  250.       FEdit.SetBounds(Left + Parent.Left, Top + Parent.Top,
  251.          FWidth, FHeight);
  252.       FEdit.Parent := Parent.Parent;
  253.    end
  254.    else
  255.    begin
  256.       FEdit := TEdit.Create(Parent);
  257.       FEdit.SetBounds(Left, Top, FWidth, FHeight);
  258.       FEdit.Parent := Parent;
  259.    end;
  260.    FEdit.Font := Font;
  261.    FEdit.BorderStyle := BorderStyle;
  262.    FEdit.Color := Color;
  263.    FEdit.Ctl3D := Ctl3D;
  264.    FEdit.Cursor := Cursor;
  265.    FEdit.HelpContext := HelpContext;
  266.    FEdit.Hint := Hint;
  267.    FEdit.ParentColor := ParentColor;
  268.    FEdit.ParentCtl3D := ParentCtl3D;
  269.    FEdit.ParentFont := ParentFont;
  270.    FEdit.ParentShowHint := ParentShowHint;
  271.    FEdit.ShowHint := ShowHint;
  272.    FEdit.TabOrder := TabOrder;
  273.    FEdit.TabStop := TabStop;
  274.    FEdit.Enabled := Enabled;
  275.    FEdit.OnEnter := FEditOnEnter;
  276.    FEdit.OnMouseDown := FEditMouseDown;
  277.  
  278.    FOnExit := OnExit;
  279.    Self.OnExit := MemoOnExit;
  280.  
  281.    self.SetBounds(Left, Top, FWidthExpld, FHeightExpld);
  282.  
  283.    {We need to retarget the focusControl Component of any
  284.    TLabel which points to us.}
  285.    T := parent;
  286.    for i := 0 to T.ComponentCount - 1 do
  287.    begin
  288.       if T.Components[i] is TLabel then
  289.       begin
  290.          P := T.Components[i] as TLabel;
  291.          if P.FocusControl = self then
  292.             P.FocusControl := FEdit;
  293.       end;
  294.    end;
  295.  
  296.  
  297. end;
  298.  
  299. function GetInstallPage: string;
  300. var
  301.    IniFile: TIniFile;
  302. begin
  303.    try
  304.       IniFile := TIniFile.Create('dbmemox.ini');
  305.       Result := IniFile.ReadString('Install', 'Page', 'Samples');
  306.       IniFile.Free;
  307.    except
  308.       on exception do
  309.       begin
  310.          Result := 'Samples';
  311.          IniFile.Free;
  312.       end;
  313.    end;
  314. end;
  315.  
  316. procedure Register;
  317. begin
  318.   RegisterComponents(GetInstallPage, [TDBMemoXpld]);
  319. end;
  320.  
  321. end.
  322.